00100	C ***** SCANNER *************************  
00200		SUBROUTINE SCANR
00250		DIMENSION IP(30)
00300		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
00400		1 ,IQ(27),ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
00500		1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
00600		EQUIVALENCE(IF,ISCA(6)),(ISS,ISCA(9)),(IE,ISCA(5)),(IDOT,IDAT(11))
00700		1 ,(IEN,ISCA(4)),(IP,P)
00800	      NNUM=-1     
00900	      ISKP=0
01000	      JJ=0  
01100		XMINUS=1.    
01200	999      IDECI=-1  
01300	      M=0   
01400	2799	N=INP(ML)
01500		IF(N.NE.IQT)GO TO 899
01600		JA=-1
01700		ML=ML+1
01800		ISUB=8
01900		JJ=JJ+1
02000		VX(JJ)=ML
02100	C  POINTS TO FIRST LIT. CHAR.
02200		DO 1177 K=ML,72
02300		IF(INP(K).NE.IQT)GO TO 1177
02400		ML=K+1
02500	2177	N=INP(ML)
02600		GO TO 899
02700	1177	CONTINUE
02800	CC	GO TO 99
02900	C  SKIPS 'LIT' ITEMS IN RAN. SELECTION
03000	899   ML=ML+1
03100		IF(N.EQ.ISEMI)GO TO 751
03200		IF(N.NE.IBLA.AND.N.NE.',')GO TO 510
03300	4702      IF(ISKP)202,2799,2799
03400	
03500	510	IF(JA)GO TO 70
03600	C********** MAY 22,71
03700	      DO 77 K=1,12   
03800	      IF(N.NE.ISCA(K))GO TO 77
03900		IF(K.NE.2.AND.K.NE.4)GO TO 511
04000		NSWCH=K-4
04100		GO TO 2177
04200	C  TO SWITCH ALWAYS USE OCT.#  /PBF4/  /NE5/  P=PROXIMITY, N=NORMAL
04300	C ************ MAY 22,71
04400	511   NNUM=K
04500		JJ=JJ+1
04600		NFLG=-1
04700		N=INP(ML)
04800		IF(N.NE.IF)GO TO 410
04900		NNUM=NNUM-1
05000		GO TO 610
05100	410	IF(N.NE.ISS)GO TO 3410
05200		NNUM=NNUM+1
05300	610	ML=ML+1
05400	CC3410	N=INP(ML)
05500	CC	IF(N.NE.IEN)GO TO 371
05600		N=INP(ML)
05700	3410	IF(N.NE.IEN.AND.N.NE.'I')GO TO 371
05800	C  'END' OR 'FINE' WILL END INST.
05900	C******** MAY 20,71
06000	3411	VX(JJ)=10000.
06100		IF(DUR(LK))DUR(LK)=1000.
06200		IAMP=-1
06300		RETURN
06400	371	IF(N.EQ.ISEMI.OR.N.EQ.IBLA)GO TO 5410
06500		DO 177 KN=2,8
06600	CC********* MAY 20,71  371	DO 177 KN=2,8
06700		IF(N.NE.IDAT(KN))GO TO 177
06800		JSCA=KN-2
06900		ML=ML+1
07000		GO TO 2410
07100	177	CONTINUE
07200		GO TO 6410
07300	5410	KN=-1
07400	6410	IF(NSWCH.EQ.0)GO TO 2410
07500		IF(KN)GO TO 7410
07600		IF(N.EQ.'+')NOLD=NOLD+6
07700		IF(N.EQ.'-')NOLD=NOLD-6
07800	C /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
07900	7410	IF(NOLD-NNUM.GT.5.AND.JSCA.LT.7)JSCA=JSCA+1
08000		IF(NOLD-NNUM.LT.-5.AND.JSCA.GT.0)JSCA=JSCA-1
08100	C   WILL JUMP TO NEAREST NOTE ***********  MAY 22,71
08200	2410	VX(JJ)=JSCA*12+NNUM
08300		NOLD=NNUM
08400	C ********** MAY 22,71
08500	4410	NNUM=-2
08600	CC	IF(M.EQ.IEN)NSWCH=0
08700	CC	IF(M.EQ.IPP)NSWCH=-1
08800		IF(INP(ML).EQ.ISEMI)RETURN
08900	C   ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
09000		GO TO 310
09100	C *********MAY 22,71
09200	77    CONTINUE    
09300	70    IF(N.NE.'-')GO TO 71   
09400	      XMINUS=-1.   
09500	      GO TO 2799   
09600	210	JJ=JJ+1
09700		IF(JJ.EQ.1)GO TO 3310
09800	C****** MAY 19,71
09900		XMINUS=1.
10000		VX(JJ)=0
10100	CC	IF(JJ.EQ.1)VX(JJ)=-99.
10200	C  'X N1,N2' MAY REPLACE 'REP N1,N2'.  N2=0 BECOMES N2=2
10300		GO TO 310
10400	71	IF(N.EQ.IXX)GO TO 210
10500		IF(N.EQ.'R')GO TO 73     
10600	
10700	1410  DO 78 K=1,11
10800	      IF(N.NE.IDAT(K))GO TO 78
10900		ISKP=-1
11000		IF(N.NE.IDOT)GO TO 79
11100		IDECI=M
11200		GO TO 75
11300	79    M=M+1 
11400	      IP(M)=K-1   
11500		GO TO 75
11600	78	CONTINUE
11700		IF(N.NE.IE.AND.N.NE.IF)GO TO 781
11800	C  'END' OR 'FINE' WILL END INST.
11900		JJ=1
12000		GO TO 3411
12100	781	IF(N.EQ.'/')N=ISEMI
12200	C   FOR MOTIVIC TRANFORMATIONS
12300	
12400	CC75	IF(ML.GT.72)GO TO 99
12500	75	IF(N.NE.ISEMI.AND.INP(ML).NE.1)GO TO 2799
12600	751	IF(ISKP.EQ.0)RETURN
12700	202   IF(IDECI.NE.-1)GO TO 302    
12800	      IDECI=0     
12900	      GO TO 402   
13000	302   IDECI=M-IDECI     
13100	402   KN=0  
13200	      IEXP=M-1    
13300	      IF(M.LT.1)M=1     
13400	      DO 171 K=1,M
13500		KV=10**IEXP
13600		IF(IEXP.EQ.0)KV=1
13700	      KN=KN+IP(K)*KV 
13800	171     IEXP=IEXP-1     
13900	      A=10**IDECI 
14000		IF(IDECI.EQ.0)A=1.
14100		JJ=JJ+1
14200		VX(JJ)=KN/A*XMINUS
14300		IF(ISUB.EQ.1)RETURN
14400		IF(CODE.NE.-22.)XMINUS=1.
14500	C  ONLY ONE - NEEDED FOR RHY.COMPOSITE
14600	1310	IF(INP(ML).NE.1)GO TO 310
14700		VX(JJ+1)=VX(JJ)*2.
14800		JJ=JJ+1
14900		ML=ML+1
15000		GO TO 1310
15100	206	ML=ML+2
15200	3310	VX(1)=-99.
15300	C******** MAY 19,71
15400	310      ISKP=0
15500	        IF(N.NE.ISEMI)GO TO 999
15600	
15700	    	RETURN
15800	73	JJ=JJ+1
15900		 IF(INP(ML).EQ.IE)GO TO 206    
16000	C   NEXT IS FOR A REST ('R')  
16100	      VX(JJ)=85.
16200		GO TO 4410
16300	CC206   ML=ML+2     
16400	CC    VX(JJ)=-99. 
16500	CC    GO TO 310   
16600	  	END
16700	
16800		SUBROUTINE BGSORT(BW)
16900	C  THIS SORTS BG TIMES SO NONE ARE DUPLICATED IN BNW ARRAY.
17000	C  ALLOWS 100 BG TIMES.
17100		COMMON /Q/ BNW(100),NWZ
17200		DO 5308 K=1,NWZ
17300		X=BNW(K)-.0001
17400		Y=X+.0002
17500	C   ROUND-OFF NONSENSE
17600	5308	IF(BW.GT.X.AND.BW.LT.Y)RETURN
17700		NWZ=NWZ+1
17800		BNW(NWZ)=BW
17900		RETURN
18000		END
18100	
18200		SUBROUTINE FMT(JFM,INP,MLX)
18300		DIMENSION JFM(3),INP(1)
18400		DO 1 MLX=2,72
18450		J=INP(MLX)
18500	1	IF(J.EQ.' '.OR.J.EQ.','.OR.J.EQ.';')GO TO 2
18510	C  SPACE=COMMA=SPACE, ALSO STOPS ON ";"
18600	2	MLX=MLX+1
18700		IF(MLX.GT.7)MLX=7
18800		JFM(2)='0'+(MLX-2)*536870912
18900	C   FINDS NUMBER FOR 'A' FORMAT
19000		RETURN
19100		END
20000	
20100	      SUBROUTINE RANR(VX,K)
20200	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
20300	      DIMENSION VX(1)
20400	      X=VX(K)
20500	      Y=VX(K+1)
20600	      IF(X.GT.Y)VX(K)=X+.999
20700	      IF(Y.GE.X)VX(K+1)=Y+.999
20800	      RETURN
20900	      END